home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / out18com.zip / GETFILES.INC < prev    next >
Text File  |  1993-01-04  |  4KB  |  182 lines
  1.  
  2. const getfiles_tag: string[90]
  3.    = #0'@(#)CURRENT_FILE LAST_UPDATE File list processing library 1.0'#0;
  4. #log File list processing library 1.0
  5.  
  6. (*
  7.  * getfiles - file list processing library
  8.  *
  9.  * This module will change a wildcard list of files into a
  10.  * sorted file name list.
  11.  *
  12.  *)
  13.  
  14. const
  15.    maxnumfiles =  200;
  16.    null =         #0;
  17.  
  18. type
  19.    filestring =   string [64];
  20.    filearray =    array [1.. maxnumfiles] of filestring;
  21.  
  22.  
  23. var
  24.    filetable:     filearray;
  25.    filecount:     integer;
  26.  
  27.  
  28. (*
  29.  *
  30.  * sort a portion of a file table
  31.  *
  32.  *)
  33.  
  34.  
  35. procedure sorttable (var fdir:      filearray;
  36.                      first:         integer;
  37.                      last:          integer);
  38. var
  39.    i:             integer;
  40.    swapped:       boolean;
  41.    temp:          filestring;
  42.    
  43. begin
  44.  
  45.    repeat
  46.       swapped := false;
  47.  
  48.       for i := first to last - 1 do
  49.       begin
  50.          
  51.          if fdir [i]> fdir [i + 1] then
  52.          begin
  53.             temp := fdir [i];
  54.             fdir[i]:= fdir [i + 1];
  55.             fdir[i + 1]:= temp;
  56.             swapped := true;
  57.          end;
  58.       end;
  59.    until swapped = false;
  60. end;
  61.  
  62.  
  63. (*
  64.  *
  65.  * expand a comma-seperated wildcard list into
  66.  * a list of full pathnames.
  67.  * sort files going with each wildcard, but otherwise
  68.  * preserve file order
  69.  *
  70.  *)
  71.  
  72. procedure getfiles (patternlist:   filestring;
  73.                     var fdir:      filearray;
  74.                     var num:       integer);
  75. var
  76.    i:             integer;
  77.    cf:            byte;
  78.    onedir:        filestring;
  79.    listpos:       integer;
  80.    pattern:       filestring;
  81.    curdir:        filestring;
  82.    reg:           regpack;
  83.    dta:           string[255];
  84.    c:             char;
  85.    prevnum:       integer;
  86.  
  87. begin
  88.    for i := 1 to length(patternlist) do
  89.       patternlist[i] := upcase(patternlist[i]);
  90.  
  91.    if patternlist = '-F' then   {filter standard input?}
  92.    begin
  93.       num := 1;         {make a fixed filelist instead of searching}
  94.       fdir[1] := '-F';
  95.       exit;
  96.    end;
  97.  
  98.    num := 0;
  99.    prevnum := 1;
  100.    listpos := 1;
  101.  
  102.    while listpos <= length (patternlist) do
  103.    begin
  104.       pattern := '';
  105.       c := patternlist [listpos];
  106.  
  107.       while (c <> ',') and (listpos <= length (patternlist)) do
  108.       begin
  109.          pattern := pattern + c;
  110.          listpos := listpos + 1;
  111.          c := patternlist [listpos];
  112.       end;
  113.  
  114.       listpos := listpos + 1;
  115.       curdir := pattern;
  116.  
  117.       while (length(curdir) > 0) and
  118.             (curdir [length(curdir)] <> '\') and
  119.             (curdir [length(curdir)] <> ':') do
  120.                curdir[0] := pred(curdir[0]);
  121.  
  122.       pattern := pattern + null;
  123.       reg.ax := $1a00;
  124.       reg.ds := seg (dta [1]);
  125.       reg.dx := ofs (dta [1]);
  126.       msdos(reg);              {set dta address}
  127.  
  128.       reg.ax := $4e00;
  129.       reg.cx := $21;  {match archive and read-only attributes}
  130.       reg.ds := seg (pattern [1]);
  131.       reg.dx := ofs (pattern [1]);
  132.       msdos(reg);              {find first matching file}
  133.  
  134.       cf := reg.flags and 1;
  135.  
  136.       if (cf <> 0) then
  137.          writeln(con,'warning:  no files matched  ',pattern);
  138.  
  139.       while ((cf <> 1) and (num < maxnumfiles)) do
  140.       begin
  141.  
  142.          onedir := '';
  143.          i := 0;
  144.  
  145.          repeat
  146.             c := dta [31 + i];
  147.  
  148.             if c <> null then
  149.                onedir := onedir + c;
  150.  
  151.             i := i + 1;
  152.          until c = null;          {throw out the . and .. entries}
  153.  
  154.  
  155.          if onedir [1]<> '.' then
  156.          begin
  157.             num := num + 1;
  158.             fdir[num]:= curdir + onedir;
  159.          end;
  160.  
  161.          reg.ax := $4f00;
  162.          reg.ds := seg (dta [1]);
  163.          reg.dx := ofs (dta [1]);
  164.          msdos(reg);              {keep searching for next file}
  165.  
  166.          cf := reg.flags and 1;
  167.       end;
  168.  
  169.       sorttable(fdir, prevnum, num);
  170.                                {sort each part of list seperately}
  171.  
  172.       prevnum := num + 1;
  173.    end;
  174.  
  175.    if num >= maxnumfiles then
  176.    begin
  177.       writeln(con,'warning:  files in excess of ', maxnumfiles, ' ignored');
  178.    end;
  179. end;                     {getfiles}
  180.  
  181.  
  182.